home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor1 / symbmat2.src < prev    next >
Text File  |  1991-10-19  |  5KB  |  315 lines

  1. %%HP: T(3)A(R)F(.);
  2. @ SYMBMAT2 by Marc E Blair
  3. DIR
  4.   \->q
  5.     \<<
  6.       IF QR
  7.       THEN '\->q\[]'
  8. DUP RCL SWAP PURGE
  9. '\->q' STO
  10.       ELSE '\->q' DUP
  11. RCL SWAP PURGE
  12. '\->q\[]' STO
  13.       END QR NOT
  14. 'QR' STO
  15.     \>>
  16.   Rr
  17.     \<< Dec \-> L S
  18.       \<< S L \161RR 0 1
  19. S
  20.         FOR A A L *
  21. A - 2 + PICK +
  22.         NEXT
  23.         IF ZRO?
  24. SWAP DROP NOT
  25.         THEN S L
  26. \161RR
  27.         END 1 L
  28.         FOR A S
  29. \->LIST L A - S * A +
  30. ROLLD
  31.         NEXT L
  32. \->LIST
  33.       \>>
  34.     \>>
  35.   det
  36.     \<< Dec DROP MNN
  37.     \>>
  38.   EC
  39.     \<< EVAL
  40.       DO DUP EXPAN
  41. DUP ROT
  42.       UNTIL SIZE
  43. SWAP SIZE ==
  44.       END
  45.       DO DUP COLCT
  46. DUP ROT
  47.       UNTIL SIZE
  48. SWAP SIZE ==
  49.       END
  50.     \>>
  51.   SIMEQ
  52.     \<< DUP Dec DUP
  53.       IF 6 <
  54.       THEN DUP2 1 -
  55.         IF ==
  56.         THEN DROP \->
  57. Ss
  58.           \<< 0 Ss
  59.             FOR Aa
  60. Ss DUP * Ss
  61.               FOR
  62. Bb Bb Aa + PICK Ss
  63. NEG
  64.               STEP
  65. Ss \->LIST Ss Ss 1 +
  66. * 1 + ROLLD
  67.             NEXT Ss
  68. Ss 1 + * DROPN Ss 1
  69. + ROLL \-> Cc
  70.             \<< Ss
  71. DUPN Ss \->LIST det \->
  72. Dd
  73.               \<<
  74. IF Dd ZRO? SWAP
  75. DROP NOT
  76. THEN 1 Ss
  77.   FOR Aa Ss DUPN Aa
  78. ROLL DROP Cc Aa
  79. ROLLD Ss \->LIST det
  80. Dd /
  81.     IF QR
  82.     THEN \->Q
  83.     END Ss 1 +
  84. ROLLD
  85.   NEXT Ss DROPN Ss
  86. \->LIST
  87. ELSE Ss DROPN
  88. "No Solution"
  89. END
  90.               \>>
  91.             \>>
  92.           \>>
  93.         ELSE *
  94. DROPN
  95. "BAD # OF EQS"
  96.         END SWAP
  97. DROP
  98.       ELSE * DROPN
  99. SM2
  100.       END
  101.     \>>
  102.   inv
  103.     \<< Dec \-> S L
  104.       \<< 0 L 1 -
  105.         FOR A 0 S 1
  106. -
  107.           FOR B A B
  108. == L S * L - 1 + A
  109. L * - ROLLD
  110.           NEXT
  111.         NEXT L S
  112.       \>> DUP + \-> L S
  113.       \<< S L \161RR 1 L
  114.         FOR A S 2 /
  115. \->LIST L A - S * A +
  116. S 2 / + ROLLD S 2 /
  117. DROPN
  118.         NEXT L
  119. \->LIST
  120.       \>>
  121.     \>>
  122.   MEC
  123.     \<< OBJ\-> \-> A
  124.       \<< 1 A 1 -
  125.         FOR B +
  126.         NEXT OBJ\-> \->
  127. S
  128.         \<< 1 S
  129.           FOR C EC
  130. S ROLLD
  131.           NEXT 1 A
  132.           FOR D S A
  133. / \->LIST S S A / D *
  134. - D + ROLLD
  135.           NEXT A
  136. \->LIST
  137.         \>>
  138.       \>>
  139.     \>>
  140.   SM2
  141.     \<< Rr 0 'ER' STO
  142. { } SWAP OBJ\-> \-> S
  143.       \<< 1 S
  144.         FOR A OBJ\->
  145. \-> L
  146.           \<< L S A -
  147. - ROLL
  148.             IF 1 \=/
  149.             THEN 1
  150. 'ER' STO
  151.             END S A
  152. - L + ROLL + S A -
  153. L 1 - + ROLLD 0 1 L
  154. 2 -
  155.             FOR C +
  156.             NEXT
  157.             IF 0 \=/
  158.             THEN 1
  159. 'ER' STO
  160.             END
  161.           \>>
  162.         NEXT
  163.         IF ER 1 ==
  164.         THEN DROP
  165. "NO SOLUTION"
  166.         END 'ER'
  167. PURGE
  168.       \>>
  169.     \>>
  170.   Dec
  171.     \<< OBJ\-> DUP TYPE
  172.       IF 5 ==
  173.       THEN EVAL
  174.       ELSE \-> L
  175.         \<< 1 L 1 -
  176.           FOR A +
  177.           NEXT OBJ\->
  178. L / L SWAP
  179.         \>>
  180.       END
  181.     \>>
  182.   ZRO?
  183.     \<< DUP TYPE 0
  184.       IF \=/
  185.       THEN 0
  186.       ELSE DUP
  187.         IF 0 \=/
  188.         THEN 0
  189.         ELSE 1
  190.         END
  191.       END
  192.     \>>
  193.   \161RR
  194.     \<< \-> L S
  195.       \<< 0 S 1 -
  196.         FOR A S L *
  197. A - DUP 1 + PICK \->
  198. F M1
  199.           \<< 1 S 1 -
  200.             FOR B F
  201. B L * - DUP 1 +
  202. PICK \-> C M2
  203.               \<< M2
  204. ZRO?
  205. IF NOT
  206. THEN DROP 0 L 1 -
  207.   FOR D C A + D -
  208. ROLL M1 0 'DOIT'
  209. STO ZRO?
  210.     IF NOT
  211.     THEN *
  212.     ELSE DROP 1
  213. 'DOIT' STO
  214.     END F A + D -
  215. PICK M2 ZRO?
  216.     IF NOT
  217.     THEN *
  218.     ELSE DROP 1
  219. 'DOIT' STO
  220.     END - EXPAN
  221. COLCT C A + D -
  222. ROLLD
  223.   NEXT
  224. ELSE DROP
  225. END
  226.               \>>
  227.             NEXT 1
  228. L
  229.             FOR Q S
  230. L * ROLL
  231.             NEXT
  232.           \>> 'DOIT'
  233. PURGE
  234.         NEXT 0 S 1
  235. -
  236.         FOR B L S B
  237. - * B - PICK S B -
  238. L * \-> D F
  239.           \<< 0 L 1 -
  240.             FOR C F
  241. C - ROLL
  242.               IF D
  243. TYPE 0 ==
  244.               THEN
  245. IF D 0 ==
  246. THEN \oo *
  247. ELSE D / COLCT
  248.   IF QR
  249.   THEN \->Q
  250.   END DUP TYPE 9 ==
  251. OVER EVAL DUP IP ==
  252. AND
  253.   IF DUP TYPE 0 ==
  254.   THEN
  255.     IF
  256.     THEN EVAL
  257.     END
  258.   ELSE DROP
  259.   END
  260. END
  261.               ELSE
  262. D / COLCT
  263.               END F
  264. C - ROLLD
  265.             NEXT
  266.           \>>
  267.         NEXT
  268.       \>>
  269.     \>>
  270.   MNN
  271.     \<< \-> Ss
  272.       \<<
  273.         IF Ss 3 ==
  274.         THEN 6 DUPN
  275. 6 DUPN ROT DROP 4
  276. ROLL * 3 ROLLD * -
  277. SWAP DROP 16 PICK *
  278. 16 ROLLD SWAP DROP
  279. 4 ROLL DROP 4 ROLL
  280. * 3 ROLLD * - 9
  281. PICK * 10 ROLLD
  282. DROP ROT DROP 4
  283. ROLL * 3 ROLLD * -
  284. * ROT DROP SWAP
  285. DROP SWAP - +
  286.         ELSE
  287.           IF Ss 2
  288. ==
  289.           THEN 4
  290. ROLL * 3 ROLLD * -
  291.           ELSE 1 Ss
  292.             FOR Aa
  293. Ss DUP DUP * SWAP -
  294. DUPN Ss DUP * Ss 2
  295. * - 0
  296.               FOR
  297. Bb Bb Aa + ROLL
  298. DROP Ss NEG
  299.               STEP
  300. Ss 1 - MNN Ss DUP *
  301. Ss - Aa + 1 + PICK
  302. * -1 Aa Ss + ^ * Ss
  303. Ss * 1 + ROLLD
  304.             NEXT Ss
  305. Ss * DROPN 1 Ss 1 -
  306.             FOR Aa
  307. +
  308.             NEXT
  309.           END
  310.         END
  311.       \>>
  312.     \>>
  313.   QR 0
  314. END
  315.